home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / adatutor / csparts / clialdos.ada next >
Text File  |  1996-01-30  |  4KB  |  125 lines
  1. --::::::::::
  2. --clialsys.ada
  3. --::::::::::
  4. -- This implementation of Package Body CLI is Alsys-specific (SUN).
  5. -- It requires the Alsys package DOS.
  6. -- Alsys Ada, Version 5
  7. with DOS;
  8. package body CLI is
  9.  
  10.    LOCAL_ARGC : NATURAL;
  11.  
  12.    type TOKEN_SCAN_STATE is (OUTSIDE_OF_TOKEN, INSIDE_OF_TOKEN);
  13.  
  14.    function ARGC_VALUE (TOKENS : in STRING) return NATURAL is
  15.       COUNTER : NATURAL := 0;
  16.       CURRENT_STATE : TOKEN_SCAN_STATE := OUTSIDE_OF_TOKEN;
  17.    begin
  18.       for I in TOKENS'FIRST .. TOKENS'LAST loop
  19.           case CURRENT_STATE is
  20.               when OUTSIDE_OF_TOKEN =>
  21.                   if TOKENS(I) > ' ' then
  22.                       COUNTER := COUNTER + 1;
  23.                       CURRENT_STATE := INSIDE_OF_TOKEN;
  24.                   end if;
  25.               when INSIDE_OF_TOKEN =>
  26.                   if TOKENS(I) <= ' ' then
  27.                       CURRENT_STATE := OUTSIDE_OF_TOKEN;
  28.                   end if;
  29.           end case;
  30.       end loop;
  31.       return COUNTER;
  32.    end ARGC_VALUE;
  33.  
  34.    procedure INITIALIZE (PROGRAM_NAME        : in STRING;
  35.                          COMMAND_LINE_PROMPT : in STRING) is
  36.       
  37.       --========================= PDL ===========================
  38.       --|ABSTRACT:
  39.       --|    INITIALIZE performs necessary initializations.
  40.       --|DESIGN DESCRIPTION:
  41.       --|    Set the value of LOCAL_ARGC by parsing tokens.
  42.       --=========================================================
  43.       
  44.    begin
  45.       LOCAL_ARGC := ARGC_VALUE (DOS.GET_PARMS) + 1;
  46.    end INITIALIZE;
  47.    
  48.    function ARGC return NATURAL is
  49.       
  50.       --========================= PDL ===========================
  51.       --|ABSTRACT:
  52.       --|    ARGC returns the argument count.
  53.       --|DESIGN DESCRIPTION:
  54.       --|    Return LOCAL_ARGC.
  55.       --=========================================================
  56.       
  57.    begin
  58.       return LOCAL_ARGC;
  59.    end ARGC;
  60.  
  61.    function ARG_VALUE (TOKENS : in STRING; INDEX : in NATURAL)
  62.      return STRING is
  63.        FIRST, LAST, COUNTER : NATURAL;
  64.        CURRENT_STATE : TOKEN_SCAN_STATE := OUTSIDE_OF_TOKEN;
  65.    begin
  66.       FIRST := TOKENS'FIRST;
  67.       LAST := TOKENS'FIRST-1;
  68.       COUNTER := 0;
  69.       if INDEX = 0 then
  70.           return DOS.GET_PROGRAM_NAME;
  71.       else
  72.           for I in TOKENS'FIRST .. TOKENS'LAST loop
  73.               case CURRENT_STATE is
  74.                   when OUTSIDE_OF_TOKEN =>
  75.                       if TOKENS(I) > ' ' then
  76.                           COUNTER := COUNTER + 1;
  77.                           CURRENT_STATE := INSIDE_OF_TOKEN;
  78.                           if COUNTER = INDEX then
  79.                               FIRST := I;
  80.                               LAST := TOKENS'LAST;
  81.                           end if;
  82.                       end if;
  83.                   when INSIDE_OF_TOKEN =>
  84.                       if TOKENS(I) <= ' ' then
  85.                           CURRENT_STATE := OUTSIDE_OF_TOKEN;
  86.                           if COUNTER = INDEX then
  87.                               LAST := I - 1;
  88.                           end if;
  89.                       end if;
  90.               end case;
  91.           end loop;
  92.           if LAST < FIRST then
  93.             return "";
  94.           else
  95.             return TOKENS(FIRST .. LAST);
  96.           end if;
  97.       end if;
  98.    end ARG_VALUE;
  99.  
  100.    function ARGV (INDEX : in NATURAL) return STRING is
  101.       
  102.       --========================= PDL ===========================
  103.       --|ABSTRACT:
  104.       --|    ARGV returns the indicated argument string.
  105.       --|DESIGN DESCRIPTION:
  106.       --|    If INDEX is out of range, raise INVALID_INDEX
  107.       --|    Run parse and return desired token.
  108.       --=========================================================
  109.       
  110.    begin
  111.       if INDEX >= LOCAL_ARGC then
  112.          raise INVALID_INDEX;
  113.       end if;
  114.       return ARG_VALUE (DOS.GET_PARMS, INDEX);
  115.    exception
  116.       when INVALID_INDEX  =>
  117.          raise ;
  118.       when others    =>
  119.          raise UNEXPECTED_ERROR;
  120.    end ARGV;
  121.  
  122. begin -- Initialization section
  123.   INITIALIZE("", "");   
  124. end CLI;
  125.